home *** CD-ROM | disk | FTP | other *** search
/ Aminet 16 / Aminet 16 (1996)(GTI - Schatztruhe)[!][Dec 1996].iso / Aminet / dev / src / wangisrc.lha / wangi / units / AppIcon.PAS next >
Pascal/Delphi Source File  |  1995-01-20  |  2KB  |  82 lines
  1. Unit AppIcon;
  2.  
  3. INTERFACE
  4.  
  5. Uses
  6.     Exec, Icon, Workbench, Dos;
  7.     
  8. Type
  9.     tAIHandle = Record
  10.         ai_AppIcon : pAppIcon;
  11.         ai_MsgPort : pMsgPort;
  12.     End;
  13.     
  14. Function AddAIcon(VAR ai       : tAIHandle;
  15.                       fn, 
  16.                       iname    : String;
  17.                       Left,
  18.                       Top,
  19.                       id,
  20.                       UserData : LONG;
  21.                       RealRet  : Boolean) : Boolean;
  22. Procedure RemoveAIcon(VAR ai   : tAIHandle);
  23.  
  24. IMPLEMENTATION
  25.  
  26. Function AddAIcon;
  27.  
  28. Var
  29.     dobj : pDiskObject;
  30.  
  31. Begin
  32.     AddAIcon := False;
  33.     iname := iname + #0;
  34.     ai.ai_MsgPort := CreateMsgPort;
  35.     If ai.ai_MsgPort <> NIL then begin
  36.         dobj := NIL;
  37.         If fn <> '' then begin
  38.             fn := fn + #0;
  39.             dobj := GetDiskObjectNew(@fn[1]);
  40.         End;
  41.         If dobj = NIL then begin
  42.             { get program icon }
  43.             fn := Paramstr(0) + #0;
  44.             dobj := GetDiskObjectNew(@fn[1]);
  45.         End;
  46.         If dobj <> NIL then begin
  47.             With dobj^ do begin
  48.                 do_Magic := 0;
  49.                 do_Version := 0;
  50.                 do_Type := 0;
  51.                 do_CurrentX := Left;
  52.                 do_CurrentY := Top;
  53.             End;
  54.             ai.ai_AppIcon := AddAppIconA(id, userdata, @iname[1], ai.ai_MsgPort, NIL, dobj, NIL);
  55.             If NOT ((ai.ai_AppIcon = NIL) and RealRet) then
  56.                 AddAIcon := True;
  57.             FreeDiskObject(dobj);
  58.         End;
  59.     End;
  60. End;
  61.  
  62.  
  63. Procedure RemoveAIcon;
  64.  
  65. Var
  66.     m  : pMessage;
  67.     ok : Boolean;
  68.     
  69. begin
  70.     If ai.ai_MsgPort <> NIL then begin
  71.         m := GetMsg(ai.ai_MsgPort);
  72.         While m <> NIL do begin
  73.             ReplyMsg(m);
  74.             m := GetMsg(ai.ai_MsgPort);
  75.         End;
  76.         if ai.ai_AppIcon <> NIL then
  77.             Ok := RemoveAppIcon(ai.ai_AppIcon);
  78.         DeleteMsgPort(ai.ai_MsgPort);
  79.     End;
  80. End;
  81.  
  82. End.